perm filename PARE.SAI[X,ALS]1 blob sn#078549 filedate 1973-12-23 generic text, type T, neo UTF8
00010	BEGIN "FIX"
00020	DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00060	DEFINE ⊃="⊂";
00070	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00090	LABEL STARTP,STOPP,TOFORM;
00100	 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00120	 require "INDATE[X,ALS]" LOAD_MODULE;
00220	 EXTERNAL PROCEDURE PREPARE;
00230	EXTERNAL PROCEDURE DEFINES;
00240	EXTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00250	EXTERNAL PROCEDURE DATOUT;
00260	EXTERNAL INTEGER INFLAG,NX;
00270	\ INTERNAL REAL ARRAY C[0:512];
00320	\ INTEGER ARRAY LFILE[0:'177];
00350	\ INTERNAL INTEGER ARRAY FVAL[0:8];
00375	\ INTEGER ARRAY FFTB[0:511]; INTEGER FFTX;
00380	INTEGER FX;
00400	INTEGER I,J,K,L,PP,CHAN2,EOF,POINTF;
00420	INTERNAL INTEGER M,N;
00440	 INTEGER    JP;
00470	BOOLEAN ER;
00490	INTERNAL INTEGER CHAN5;
00510	STRING FILEN,FILEF,READ,READ1,READT,
00515	   READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00520	
00600	
02490	
02500	PROCEDURE FFTIN;
02510	BEGIN
02520	INTEGER I,J;
02530	
02540	IF FFTX≥512 THEN BEGIN
02560	  FFTX←0; FOR I←0 STEP 1 UNTIL 511 DO FFTB[I]←0;
02565	  IF EOF=0 THEN ARRYIN(CHAN2,FFTB[0],512);
02567	IF EOF=0 THEN OUTSTR("DATA BEING READ"&CRLF) ELSE OUTSTR("EOF"&CRLF);
02570	  END;
02580	
02590	FVAL[4]←FFTB[FFTX];
02600	POINTF←POINT(9,FFTB[FFTX+1],-1);
02610	FOR I←0 STEP 1 UNTIL 251 DO BEGIN
02630	  C[I]←ILDB(POINTF);
02635	  C[I]←C[I]/4;
02640	  END;
02650	FFTX←FFTX+64;
02660	
02670	END;
     

00010	
00020	FILEO←"SEG1.FFT[SYN,ALS]";
00030	INFLAG←0; PREPARE; INFLAG←1; DEFINES; ⊂ Get names and limits;
00040	STDBRK(1);
00090	
00100	CHAN2←2;CHAN5←5;
00370	
00380	STARTP:
00390	
00400	OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00410	IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00420	
00430	⊂ Begin FILEREAD;
00440	FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00460	SETFORMAT(1,0); FILEQ←CVS(PP);
00620	
00630	READT←FILEO[1 TO 3]&FILEQ&".FFT[SYN,ALS]";
00640	CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOF);
00650	LOOKUP(CHAN2,READT,ER); TFILE←READT;
00660	WHILE ER DO BEGIN
00670	   IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00680	     GOTO STARTP; END;
00690	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00700	   LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00710	ARRYIN(CHAN2,LFILE[0],'200);	⊂ Input header;
00720	JP←10000;
00780	
00790	FILEP←FILEO[1 TO 3]&FILEQ&".SYN[SYN,ALS]";
00800	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00810	ENTER(CHAN5,FILEP,0);
00820	OUTSTR("File "&FILEP&" has been opened");
00830	 ARRYOUT(CHAN5,LFILE[0],'200); ⊂ Write header;
00840	OUTSTR(" and header information written."&CRLF);
00850	
00857	FFTX←512;
01030	
01040	⊂ Begin "GET";
01050	
01060	WHILE TRUE DO BEGIN "GET"
01070	
01625	FFTIN;
01627	IF FFTB[0]=0 THEN DONE "GET";
01630	 PREPARE;
01640	
01650	JP←JP-1; READ1←INCHRS;
01660	IF (READ1="F")∨(READ1="f") THEN BEGIN CLRBUF; READ1←"";
01670	  JP←-10; OUTSTR(CRLF&LF&"Will stop at the end of this file"&CRLF&LF); END;
01680	IF (READ1="E")∨(READ1="e") then goto stopp;
02170	
02180	
02190	END "GET";
02210	
02215	DATOUT;
02220	CLOSE(CHAN2); CLOSE(CHAN5);
02230	 IF JP<0 THEN DONE;
02240	END "FILEREAD";
02250	
02260	OUTSTR("Data are exhausted"&CRLF&LF);
02270	STOPP:
02280	CLOSE(CHAN5);CLOSE(CHAN2);
02290	
02300	END "FIX";
02310